home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / baswiz19.zip / GDEMO.BAS < prev    next >
BASIC Source File  |  1993-02-01  |  9KB  |  269 lines
  1. '   +----------------------------------------------------------------------+
  2. '   |                                                                      |
  3. '   |         BASWIZ  Copyright (c) 1990-1993  Thomas G. Hanlin III        |
  4. '   |                                                                      |
  5. '   |                       The BASIC Wizard's Library                     |
  6. '   |                                                                      |
  7. '   +----------------------------------------------------------------------+
  8.  
  9.    DECLARE SUB BFont (BYVAL FontNr%)
  10.    DECLARE SUB GetDisplay (Adapter%, Mono%)
  11.    DECLARE SUB G1Banner (St$, X%, Y%, Xmul%, Ymul%)
  12.    DECLARE SUB G1Border (BYVAL Colour%)
  13.    DECLARE SUB G1Box (BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL Fill%)
  14.    DECLARE SUB G1Color (BYVAL Foregnd%, BYVAL Backgnd%)
  15.    DECLARE SUB G1Ellipse (CenterX%, CenterY%, XRadius%, YRadius%)
  16.    DECLARE SUB G1Line (BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%)
  17.    DECLARE SUB G1Locate (BYVAL Row%, BYVAL Column%)
  18.    DECLARE SUB G1Mode (BYVAL ModeNr%)
  19.    DECLARE SUB G1PaletteA (BYVAL PaletteNr%)
  20.    DECLARE SUB G1Plot (BYVAL X%, BYVAL Y%)
  21.    DECLARE SUB G1Polygon (X%, Y%, Radius%, Vertices%, Angle!)
  22.    DECLARE SUB G1Write (St$)
  23.    DECLARE SUB G1WriteLn (St$)
  24.    DECLARE SUB G2Color (BYVAL Foregnd%, BYVAL Backgnd%)
  25.    DECLARE SUB G2LoadPCX (File$, Image%(), ErrCode%)
  26.    DECLARE SUB G2Locate (BYVAL Row%, BYVAL Column%)
  27.    DECLARE SUB G2Mode (BYVAL ModeNr%)
  28.    DECLARE SUB G2Put (X%, Y%, Image%())
  29.    DECLARE SUB G2Write (St$)
  30.    DECLARE SUB G2WriteLn (St$)
  31.    DECLARE SUB G7Box (BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL Fill%)
  32.    DECLARE SUB G7Color (BYVAL Foreground%, BYVAL Background%)
  33.    DECLARE SUB G7Locate (BYVAL Row%, BYVAL Column%)
  34.    DECLARE SUB G7Mode (BYVAL Graphics%)
  35.    DECLARE SUB G7Polygon (X%, Y%, Radius%, Vertices%, Angle!)
  36.    DECLARE SUB G7Write (St$)
  37.    DECLARE SUB G7WriteLn (St$)
  38.    DECLARE SUB G13Box (BYVAL X1%, BYVAL Y1%, BYVAL X2%, BYVAL Y2%, BYVAL Fill%)
  39.    DECLARE SUB G13Cls ()
  40.    DECLARE SUB G13Color (BYVAL Foreground%, BYVAL Background%)
  41.    DECLARE SUB G13Locate (BYVAL Row%, BYVAL Column%)
  42.    DECLARE SUB G13Mode (BYVAL Graphics%)
  43.    DECLARE SUB G13Polygon (X%, Y%, Radius%, Vertices%, Angle!)
  44.    DECLARE SUB G13ShowBMP (FileName$, OrigX%, OrigY%, ErrCode%)
  45.    DECLARE SUB G13Write (St$)
  46.    DECLARE SUB G13WriteLn (St$)
  47.  
  48.    DEFINT A-Z
  49.  
  50.    DEF FNR (X) = INT(RND * X)
  51.  
  52.    RANDOMIZE TIMER
  53.  
  54.    GetDisplay Adapter, Mono
  55.  
  56.    IF Adapter < 3 THEN
  57.       PRINT "Sorry, but you must have a CGA, EGA or VGA display active to run this demo."
  58.       END
  59.    END IF
  60.  
  61.    G1Mode 1                          ' CGA 320x200 mode
  62.    G1PaletteA 0                      ' Green, Red, Yellow palette
  63.  
  64.    BFont 1
  65.    G1Color 1, 0
  66.    G1Banner "BASWIZ", 0, 0, 3, 2
  67.    BFont 0
  68.    G1Color 3, 0
  69.    G1Banner "Copyright (c)1990", 179, 5, 1, 1
  70.    G1Banner "Thomas G. Hanlin", 182, 15, 1, 1
  71.  
  72.    BFont 2
  73.    G1Color 2, 0
  74.    G1Banner "This is the BASIC Wizard's Library.", 0, 40, 1, 1
  75.  
  76.    BFont 1
  77.    G1Color 1, 0
  78.    G1Banner "Flexible text handling is a natural", 0, 68, 1, 1
  79.    G1Banner "aspect of graphics modes.  The BASWIZ", 0, 82, 1, 1
  80.    G1Banner "library takes full advantage of that,", 0, 96, 1, 1
  81.    G1Banner "with a selection of fonts and fast", 0, 110, 1, 1
  82.    G1Banner "full-color text support.", 0, 124, 1, 1
  83.  
  84.    BFont 0
  85.    G1Color 3, 0
  86.    G1Banner "This is CGA mode SCREEN 1, by the way.", 0, 150, 1, 1
  87.  
  88.    BFont 2
  89.    G1Color 2, 0
  90.    G1Banner "Now let's see some graphics!", 0, 170, 1, 1
  91.  
  92.    G1Locate 25, 14
  93.    G1Color 2, 3
  94.    G1Write "Press a key"
  95.  
  96.    DO
  97.    LOOP WHILE LEN(INKEY$)
  98.    DO
  99.       ky$ = INKEY$
  100.    LOOP UNTIL LEN(ky$)
  101.    IF ky$ = CHR$(27) THEN GOTO Done
  102.  
  103.    G1Color 0, 0
  104.    G1Box 0, 30, 319, 189, 1
  105.    G1Color 2, 0
  106.    G1Box 0, 26, 319, 188, 0
  107.  
  108.    G1Color 1, 0
  109.    G1Locate 23, 2
  110.    G1Write "Dots, Lines, Boxes, Ellipses..."
  111.  
  112.    FOR Dot = 1 TO 200
  113.       G1Color FNR(3) + 1, 0
  114.       G1Plot FNR(316) + 2, FNR(140) + 28
  115.    NEXT
  116.  
  117.    FOR Lin = 1 TO 10
  118.       G1Color FNR(3) + 1, 0
  119.       G1Line FNR(316) + 2, FNR(140) + 28, FNR(315) + 3, FNR(139) + 29
  120.    NEXT
  121.  
  122.    FOR Box = 1 TO 10
  123.       G1Color FNR(3) + 1, 0
  124.       X = FNR(250) + 2
  125.       Y = FNR(112) + 28
  126.       G1Box X, Y, X + FNR(60) + 1, Y + FNR(25) + 1, FNR(2)
  127.    NEXT
  128.  
  129.    FOR Ellipse = 1 TO 10
  130.       G1Color FNR(3) + 1, 0
  131.       X = FNR(215) + 40
  132.       Y = FNR(85) + 60
  133.       G1Ellipse X, Y, FNR(25) + 5, FNR(20) + 5
  134.    NEXT
  135.  
  136.    DO
  137.    LOOP WHILE LEN(INKEY$)
  138.    DO
  139.       ky$ = INKEY$
  140.    LOOP UNTIL LEN(ky$)
  141.    IF ky$ = CHR$(27) THEN GOTO Done
  142.  
  143.    G1Color 0, 0
  144.    G1Box 1, 27, 318, 187, 1
  145.  
  146.    G1Color 1, 0
  147.    G1Locate 23, 2
  148.    G1Write "But why stop at the usual?"
  149.  
  150.    FOR Poly = 1 TO 12
  151.       G1Color FNR(3) + 1, 0
  152.       X = FNR(212) + 40
  153.       Y = FNR(90) + 60
  154.       G1Polygon X, Y, FNR(25) + 5, FNR(6) + 3, 3.14159 * RND
  155.    NEXT
  156.  
  157.    DO
  158.    LOOP WHILE LEN(INKEY$)
  159.    DO
  160.       ky$ = INKEY$
  161.    LOOP UNTIL LEN(ky$)
  162.    IF ky$ = CHR$(27) THEN GOTO Done
  163.  
  164.    G2Mode 1                          ' CGA 640x200 mode
  165.    IF Adapter = 3 THEN               ' if CGA...
  166.       G1Border 1                     '    set foreground color to blue
  167.    END IF
  168.    G2Locate 1, 1
  169.    G2Color 1, 0
  170.    G2WriteLn "There are a few additional routines of interest which are designed to work"
  171.    G2WriteLn "only in SCREEN 2 mode at this time.  These are the picture readers, which"
  172.    G2WriteLn "allow you to read in .MAC and .PCX pictures into a GET/PUT image.  Here's"
  173.    G2WriteLn "a sample from GDEMO.PCX:"
  174.  
  175.    REDIM Image(1)
  176.    G2LoadPCX "GDEMO.PCX", Image(), ErrCode
  177.    G2Put 40, 40, Image()
  178.  
  179.    G2Locate 15, 1
  180.    G2WriteLn "Of course, that's not the end of it!  There are many other routines that"
  181.    G2WriteLn "are not included in this demonstration.  One of 'em in particular which you"
  182.    G2WriteLn "may like is a routine to detect what kind of display adapter is attached and"
  183.    G2WriteLn "whether the display is color or monochrome.  BasWiz can handle any type of"
  184.    G2WriteLn "display, or even dual display systems!"
  185.    G2WriteLn ""
  186.    G2WriteLn "See BASWIZ.DOC for more details."
  187.  
  188.    G2Locate 25, 33
  189.    G2Color 0, 1
  190.    G2Write "Press any key"
  191.  
  192.    IF Adapter = 4 THEN                     ' if EGA...
  193.       DO
  194.       LOOP WHILE LEN(INKEY$)
  195.       DO
  196.          ky$ = INKEY$
  197.       LOOP UNTIL LEN(ky$)
  198.       IF ky$ = CHR$(27) THEN GOTO Done
  199.       G7Mode 1                             ' ...put into low-res EGA mode
  200.       G7Color 4, 2
  201.       G7WriteLn "Ah, I see you have an EGA!  Of course,"
  202.       G7Color 0, 3
  203.       G7WriteLn "BASWIZ supports the various EGA modes"
  204.       G7Color 7, 1
  205.       G7WriteLn "as well as the Hercules, CGA and VGA."
  206.       FOR Y = 0 TO 31
  207.          G7Color Y AND 15, 0
  208.          G7Box Y, Y + 64, 319 - Y, (64 - Y) + 120, (Y = 100)
  209.          IF Y > 15 THEN
  210.             G7Polygon Y * 15 - 194, 112, 5, FNR(6) + 3, .75 * 3.141593
  211.             G7Color ((Y XOR 15) AND 15), 0
  212.             G7Polygon Y * 15 - 194, 136, 5, FNR(6) + 3, 0
  213.          END IF
  214.       NEXT
  215.       G7Locate 25, 14
  216.       G7Color 15, 4
  217.       G7Write "Press any key"
  218.    ELSEIF Adapter = 6 THEN                     ' if VGA...
  219.       DO
  220.       LOOP WHILE LEN(INKEY$)
  221.       DO
  222.          ky$ = INKEY$
  223.       LOOP UNTIL LEN(ky$)
  224.       IF ky$ = CHR$(27) THEN GOTO Done
  225.       G13Mode 1                            ' ...put into low-res VGA mode
  226.       G13Color 4, 2
  227.       G13WriteLn "Ah, I see you have a VGA!  Of course,"
  228.       G13Color 0, 3
  229.       G13WriteLn "BASWIZ supports the various VGA modes"
  230.       G13Color 7, 1
  231.       G13WriteLn "as well as Hercules, CGA and EGA."
  232.       FOR Y = 0 TO 31
  233.          G13Color Y + 16, 0
  234.          G13Box Y, Y + 64, 319 - Y, (64 - Y) + 120, (Y = 100)
  235.          IF Y > 15 THEN
  236.             G13Polygon Y * 15 - 194, 112, 5, FNR(6) + 3, .75 * 3.141593
  237.             G13Color 64 - Y, 0
  238.             G13Polygon Y * 15 - 194, 136, 5, FNR(6) + 3, 0
  239.          END IF
  240.       NEXT
  241.       G13Locate 25, 14
  242.       G13Color 15, 4
  243.       G13Write "Press any key"
  244.       DO
  245.       LOOP WHILE LEN(INKEY$)
  246.       DO
  247.          ky$ = INKEY$
  248.       LOOP UNTIL LEN(ky$)
  249.       IF ky$ = CHR$(27) THEN GOTO Done
  250.  
  251.       G13Cls
  252.       G13Color 7, 0
  253.       G13Write "BasWiz displays 256-color BMP files too!"
  254.       G13ShowBMP "GDEMO.BMP", 56, 9, ErrCode
  255.       G13Locate 25, 14
  256.       G13Color 15, 4
  257.       G13Write "Press any key"
  258.    END IF
  259.  
  260.    DO
  261.    LOOP WHILE LEN(INKEY$)
  262.    DO
  263.       ky$ = INKEY$
  264.    LOOP UNTIL LEN(ky$)
  265.    IF ky$ = CHR$(27) THEN GOTO Done
  266.  
  267. Done:
  268.    G1Mode 0                          ' restore text mode
  269.